home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / db.src < prev    next >
Text File  |  1990-09-14  |  4KB  |  155 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ Version 1.1
  3. @ Copyright 1990 Ross Barnes
  4. DIR
  5.   XQDB
  6.     \<< RCLMENU \-> m
  7.       \<< :0: { DB INIT.0 } EVAL { USE FIND EDIT ADD DEL EXIT } \-> m1
  8.         \<<
  9.           DO m1 TMENU :0: { DB VU.0 } EVAL -1 WAIT \-> k
  10.             \<<
  11.               CASE
  12.                 k 25.1 SAME
  13.                 THEN DBINFO 2 GET 1 - :0: { DB MOV.0 } EVAL 0
  14.                 END k 25.3 SAME
  15.                 THEN 1 :0: { DB MOV.0 } EVAL 0
  16.                 END k 35.1 SAME
  17.                 THEN DBINFO 2 GET 1 + :0: { DB MOV.0 } EVAL 0
  18.                 END k 35.3 SAME
  19.                 THEN MAXR \->NUM :0: { DB MOV.0 } EVAL 0
  20.                 END k 51.1 SAME
  21.                 THEN DBINFO OBJ\-> DROP2 GET 0
  22.                 END k 11.1 SAME
  23.                 THEN :0: { DB USE.0 } EVAL 0
  24.                 END k 11.2 SAME
  25.                 THEN :0: { DB NUDB } EVAL 1 "" 3 \->LIST 'DBINFO' STO 0
  26.                 END k 12.1 SAME
  27.                 THEN :0: { DB FND.0 } EVAL 0
  28.                 END k 13.1 SAME
  29.                 THEN :0: { DB EDT.0 } EVAL 0
  30.                 END k 14.1 SAME
  31.                 THEN :0: { DB ADD.0 } EVAL 0
  32.                 END k 15.1 SAME
  33.                 THEN :0: { DB DEL.0 } EVAL 0
  34.                 END k 16.1 SAME
  35.                 THEN -1
  36.                 END 0
  37.               END
  38.             \>>
  39.           UNTIL
  40.           END
  41.         \>> m MENU
  42.       \>>
  43.     \>>
  44.   DEL.0
  45.     \<< "Yy" "Delete record?" { "N" \Ga } INPUT POS
  46.       IF
  47.       THEN DBINFO OBJ\-> DROP2 \-> db recno
  48.         \<<
  49.           IF recno 1 >
  50.           THEN db RCL 1 recno 1 - SUB db RCL recno 1 + MAXR \->NUM SUB + db STO
  51.           END recno 1 - :0: { DB MOV.0 } EVAL
  52.         \>>
  53.       END
  54.     \>>
  55.   INIT.0
  56.     \<<
  57.       IF VARS 'DBINFO' POS
  58.       THEN
  59.         IF DBINFO SIZE 3 ==
  60.         THEN
  61.          IF DBINFO \-> d
  62.           \<< d       TYPE 5 \=/
  63.               d 1 GET TYPE 6 \=/ OR
  64.               d 3 GET TYPE 2 \=/ OR
  65.               d 2 GET TYPE 0 \=/ OR
  66.           \>>
  67.          THEN "DBINFO is invalid" KILL
  68.          END
  69.       ELSE
  70.        "DBINFO is invalid"
  71.         KILL
  72.       END
  73.       ELSE { "" 1 "" } 'DBINFO' STO :0: { DB USE.0 } EVAL
  74.       END
  75.     \>>
  76.   NUDB
  77.     \<< "New database name?" { ".DB" 1 \Ga } INPUT OBJ\-> "Number of fields?"
  78.         { "" \Ga } INPUT OBJ\-> \-> n
  79.       \<< 1 n
  80.         FOR i "FLD" i \->STR +
  81.         NEXT n \->LIST 1 \->LIST OVER STO
  82.       \>>
  83.     \>>
  84.   EDT.0
  85.     \<< DBINFO OBJ\-> DROP2 OVER 1 GET \-> db recno flds
  86.       \<< 1 flds SIZE
  87.         FOR i flds i GET "?" + db recno GET i GET '\Ga' 2 \->LIST INPUT
  88.         NEXT flds SIZE \->LIST db recno ROT PUT
  89.       \>>
  90.     \>>
  91.   VU.0
  92.     \<< DBINFO OBJ\-> DROP2 GET \-> rec
  93.       \<< 3 7
  94.         FOR i "" i DISP
  95.         NEXT 1 rec SIZE 7 MIN
  96.         FOR i rec i GET i 2 + DISP
  97.         NEXT
  98.       \>>
  99.     \>>
  100.   USE.1
  101.     \<< { } VARS \-> vl
  102.       \<< 1 vl SIZE
  103.         FOR i vl i GET DUP \->STR ".DB" POS
  104.           IF
  105.           THEN +
  106.           ELSE DROP
  107.           END
  108.         NEXT
  109.       \>>
  110.     \>>
  111.   USE.0
  112.     \<< :0: { DB USE.1 } EVAL DUP TMENU
  113.       IF SIZE
  114.       THEN "What database?" DBINFO 1 GET \->STR 2 OVER SIZE 1 - SUB 1 \->LIST
  115.         INPUT "'" SWAP OVER + + OBJ\->
  116.       ELSE :0: { DB NUDB } EVAL
  117.       END 1 "" 3 \->LIST 'DBINFO' STO
  118.     \>>
  119.   ADD.0
  120.     \<< DBINFO 1 GET DUP 1 GET SIZE { } 1 ROT
  121.       START { "" } +
  122.       NEXT 1 \->LIST STO+ MAXR \->NUM :0: { DB MOV.0 } EVAL :0: { DB EDT.0 }
  123.       EVAL
  124.     \>>
  125.   MOV.0
  126.     \<< 'DBINFO' SWAP OVER 1 GET RCL SIZE MIN 1 MAX 2 SWAP PUT
  127.     \>>
  128.   FND.0
  129.     \<< DBINFO OBJ\-> DROP '\Ga' 2 \->LIST "Find what?" SWAP INPUT 'DBINFO' OVER
  130.         3 SWAP PUT 3 ROLLD 1 + OVER RCL SIZE MIN ROT :0: { DB FND.1 } EVAL DUP
  131.       IF
  132.       THEN 'DBINFO' 2 ROT PUT
  133.       ELSE DROP
  134.       END
  135.     \>>
  136.   FND.1
  137.     \<< \-> fs
  138.       \<<
  139.         DO \-> i
  140.           \<< i GETI \->STR fs POS
  141.             IF
  142.             THEN DROP2 i 1
  143.             ELSE DUP 1 ==
  144.               IF
  145.               THEN DROP2 0 1
  146.               ELSE 0
  147.               END
  148.             END
  149.           \>>
  150.         UNTIL
  151.         END
  152.       \>>
  153.     \>>
  154. END
  155.